home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / tex / td187src.lzh / MTDIR.I < prev    next >
Encoding:
Modula Implementation  |  1991-06-08  |  10.0 KB  |  350 lines
  1. (*#########################################################################
  2.                              D I R E C T O R Y
  3.   #########################################################################
  4.   V1.0  01.05.90        Peter Hellinger         TDI-Modula-2
  5.   #########################################################################*)
  6.  
  7. IMPLEMENTATION MODULE mtDir;
  8.  
  9. (*------------------------------*)
  10. (*       COMPILERSWITCHES       *)
  11. (*------------------------------*)
  12. (*  TDI-Version:   DEAKTIVIERT  *)
  13. (*------------------------------*)
  14. (* V-  Overflow-Checks          *)
  15. (* R-  Range-Checks             *)
  16. (* S-  Stack-Check              *)
  17. (* N-  NIL-Checks               *)
  18. (* T-  TDI-Compiler vor 3.01    *)
  19. (* Q+  Branch statt Jumps       *)
  20. (*                              *)
  21. (*------------------------------*)
  22. (*  MM2-Version:     AKTIVIERT  *)
  23. (*------------------------------*)
  24. (*$R-   Range-Checks            *)
  25. (*$S-   Stack-Check             *)
  26. (*                              *)
  27. (*------------------------------*)
  28.  
  29. FROM SYSTEM     IMPORT  ADR, ADDRESS;
  30. FROM MagicSys   IMPORT  Nil, Null,
  31.                         Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6, Bit7,
  32.                         Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14, Bit15,
  33.                         LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL, sBITSET,
  34.                         lWORD, lINTEGER, lCARDINAL, lBITSET,
  35.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  36.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  37.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr;
  38. FROM MagicStrings  IMPORT  Append, Assign, Length, Copy, Equal, Insert, Pos;
  39.                 IMPORT  MagicAES, MagicVDI, MagicDOS, MagicTypes;
  40.                 IMPORT  XBRA;
  41.  
  42.  
  43. CONST   NullChar =      CHR (0);
  44.  
  45. VAR     version:        TosVersion;
  46.         slash:          ARRAY [0..0] OF CHAR;
  47.         exselector:     BOOLEAN;
  48.         stack:          ADDRESS;
  49.         sys[04F2H]:     MagicTypes.PtrSYSHDR;
  50.  
  51.  
  52. VAR     Search:         RECORD
  53.                          name:  ARRAY [0..255] OF CHAR;
  54.                          attr:  sBITSET;
  55.                          first: BOOLEAN;
  56.                          dta:   MagicDOS.PtrDTA;
  57.                         END; 
  58.  
  59. VAR     defDTA:         MagicDOS.DTA;
  60.         defDtaPtr:      MagicDOS.PtrDTA;
  61.  
  62.  
  63. PROCEDURE GetDir (VAR pfad, name: ARRAY OF CHAR; msg: ARRAY OF CHAR): BOOLEAN;
  64. VAR c: sCARDINAL;
  65.     m: ARRAY [0..30] OF CHAR;
  66.     b: BOOLEAN;
  67. BEGIN
  68.  GetPath (pfad);
  69.  IF exselector THEN
  70.   Assign (msg, m);  m[30]:= NullChar;
  71.   b:= MagicAES.FselExinput(m, pfad, name);
  72.  ELSE (* Normalen Selector verwenden *)
  73.   b:= MagicAES.FselInput (pfad, name);
  74.  END;
  75.  IF NOT b  THEN  Assign ('', name);  END;
  76.  RETURN b;
  77. END GetDir;
  78.  
  79.  
  80. PROCEDURE GetPath (VAR pfad: ARRAY OF CHAR);
  81. VAR drive, c, d: sCARDINAL;
  82.     p, suff:     ARRAY [0..40] OF CHAR;
  83. BEGIN
  84.  IF (pfad[0] = NullChar) OR (pfad[0] = '*') THEN
  85.   c:= Length (pfad);
  86.   IF c > 0 THEN
  87.    DEC (c);
  88.    WHILE (c > 0) & (pfad[c] # '.') DO  DEC (c);  END;
  89.    IF c > 0 THEN
  90.     d:= c;
  91.     WHILE (pfad[c] # NullChar) DO
  92.      suff [c - d]:= pfad[c];  INC (c);
  93.     END (* WHILE *);
  94.     suff[c - d]:= NullChar;
  95.    END (* IF *);
  96.   ELSE
  97.    suff[0]:= NullChar;
  98.   END (* IF *);
  99.   drive:= MagicDOS.Dgetdrv ();
  100.   Assign ('', p);
  101.   pfad[0]:= CHR (ORD ('A') + drive);
  102.   pfad[1]:= ':';  pfad[2]:= NullChar;
  103.   MagicDOS.Dgetpath (p, drive + 1);
  104.   Append (p, pfad);
  105.   Append ('\*', pfad);
  106.   IF suff[0] # NullChar THEN
  107.    Append (suff, pfad)
  108.   ELSE
  109.    Append ('.*', pfad);
  110.   END (* IF kein alter Suffix *);
  111.  END (* IF pf leer *);
  112. END GetPath;
  113.  
  114.  
  115. PROCEDURE DelTail (VAR s: ARRAY OF CHAR);
  116. VAR c: CARDINAL;
  117. BEGIN
  118.  c:= Length (s);
  119.  WHILE (c > 0) & (s [c - 1] # '\') DO
  120.   DEC (c);  s[c]:= NullChar;
  121.  END (* WHILE *);
  122. END DelTail;
  123.           
  124.  
  125. PROCEDURE SplitPath (path: ARRAY OF CHAR; VAR pfad, name, suff: ARRAY OF CHAR);
  126. VAR c, d, len, pLen:  CARDINAL;
  127. BEGIN
  128.  len:= Length (path);
  129.  IF len = 0 THEN  RETURN;  END;
  130.  pfad[0]:= NullChar;
  131.  name[0]:= NullChar;
  132.  suff[0]:= NullChar;
  133.  c:= len;
  134.  
  135.  (* Suffix abspalten wenn vorhanden: *)
  136.  IF c > 0 THEN
  137.   DEC (c); (* Index des letzten Zeichens *)
  138.   WHILE (c > 0) & (path[c] # '.') DO  DEC (c);  END;
  139.   IF c > 0 THEN (* wir haben den Punkt gefunden *)
  140.    d:= 0;
  141.    INC (c);
  142.    WHILE (path[c] # NullChar) AND (d < 3) DO
  143.     suff[d]:= path[c];  INC (c);  INC (d);
  144.    END (* WHILE *);
  145.    IF d <= HIGH (suff) THEN  suff[d]:= NullChar  END;
  146.   END (* IF *);
  147.  ELSE
  148.   suff[0]:= NullChar
  149.  END (* IF *);
  150.   
  151.  c:= len;
  152.  IF c > 0 THEN DEC (c); END;
  153.  
  154.  (* Dateinamen abspalten: *)
  155.  WHILE (c > 0) & (path[c] # '\') & (path[c] # ':') DO  DEC (c);  END;
  156.  IF (path[c] = '\') OR (path[c] = ':') THEN INC (c); END;
  157.  pLen:= c;
  158.  d:= 0;
  159.  FOR c:= c TO len - 1 DO  name[d]:= path[c];  INC (d);  END;
  160.  IF d <= HIGH (name) THEN  name[d]:= NullChar;  END;
  161.  
  162.  (* Pfad kopieren: *)
  163.  IF pLen > 0 THEN
  164.   FOR d:= 0 TO pLen - 1 DO  pfad[d]:= path[d];  END;
  165.  END (* IF *);
  166.  pfad[pLen]:= NullChar;
  167.  
  168. END SplitPath;
  169.  
  170.  
  171. PROCEDURE CompletePath (VAR pfad: ARRAY OF CHAR; standard: ARRAY OF CHAR);
  172. VAR drv, old: sCARDINAL;
  173.     dummy:    lBITSET;
  174.     drvStr:   ARRAY [0..1] OF CHAR;
  175.     path:     ARRAY [0..255] OF CHAR;
  176. BEGIN
  177.  IF pfad[0] = NullChar THEN 
  178.   (* Pfad leer, dann Standard-Pfad verwenden *)
  179.   Assign (standard, pfad)
  180.  ELSIF pfad[0] = '\' THEN 
  181.   (* Root-Dir des aktuellen Laufwerks verwenden *)
  182.   drvStr:= ' :';
  183.   drv:= MagicDOS.Dgetdrv ();
  184.   drvStr[0]:= CHR (drv + 65);
  185.   Insert (drvStr, pfad, 0);
  186.  ELSIF pfad[1] = ':' THEN
  187.   (* Laufwerksbezeichner im Pfad *)
  188.   IF pfad[2] # '\' THEN (* Standardpfad des Laufwerks verwenden *)
  189.    old:= MagicDOS.Dgetdrv ();
  190.    drv:= ORD (pfad[0]) - 65;  
  191.    MagicDOS.Dsetdrv (drv, dummy);
  192.    MagicDOS.Dgetpath (path, 0);
  193.    MagicDOS.Dsetdrv (old, dummy);
  194.    drvStr[0]:= pfad[0];
  195.    drvStr[1]:= pfad[1];
  196.    Insert (drvStr, path, 0);
  197.    Assign (path, pfad);
  198.    Append (slash, pfad);
  199.   END; 
  200.  ELSIF Pos (slash, pfad) > 0 THEN
  201.   Insert (standard, pfad, 0);
  202.  END;  
  203. END CompletePath;
  204.  
  205.  
  206. PROCEDURE GetVersion (): TosVersion;
  207. BEGIN
  208.  RETURN version;
  209. END GetVersion;
  210.  
  211.  
  212. PROCEDURE ExSelector (): BOOLEAN;
  213. BEGIN
  214.  RETURN exselector;
  215. END ExSelector;
  216.  
  217.  
  218. PROCEDURE SearchParas (maske: ARRAY OF CHAR; attribut: sBITSET;
  219.                        ptr: MagicDOS.PtrDTA; firsttime: BOOLEAN);
  220. BEGIN
  221.  WITH Search DO
  222.   Assign (maske, name);
  223.   attr:= attribut;
  224.   first:= firsttime;
  225.   dta:= ptr;
  226.  END;   
  227. END SearchParas;
  228.  
  229.  
  230. PROCEDURE Found (): BOOLEAN;
  231. VAR err: sINTEGER;
  232. BEGIN
  233.  MagicDOS.Fsetdta (Search.dta);
  234.  IF Search.first THEN
  235.   err:= MagicDOS.Fsfirst (Search.name, Search.attr);
  236.   Search.first:= FALSE;
  237.  ELSE
  238.   err:= MagicDOS.Fsnext ();
  239.  END;
  240.  RETURN (err = 0);
  241. END Found;
  242.  
  243.  
  244. PROCEDURE Exist (datei: ARRAY OF CHAR): BOOLEAN;
  245. (* Testet, ob Datei oder Ordner schon existiert *)
  246. VAR err: sINTEGER;
  247. BEGIN
  248.  MagicDOS.Fsetdta (defDtaPtr);
  249.  RETURN MagicDOS.Fsfirst (datei, {0..15}) = 0;
  250. END Exist;
  251.  
  252.  
  253. PROCEDURE Replace (oldName, wildcard: ARRAY OF CHAR; VAR new: ARRAY OF CHAR);
  254. (* Bildet aus wildcard und oldName einen neuen Dateinamen (new). *)
  255. CONST cMaxLen =  11;
  256.       cPrefLen =  8;
  257.  
  258.  PROCEDURE MakeMask (wild: ARRAY OF CHAR; VAR maske: ARRAY OF CHAR);
  259.  (* Expandiert einen Dateinamen auf 12 Zeichen, ? und * werden als ?
  260.   * eingetragen. Nichtvorhandene Zeichen werden Blanks!
  261.   *)
  262.  VAR c, d, i:   CARDINAL;
  263.  BEGIN (* MachMaske *)
  264.   c:= 0;  d:= 0;  Assign ("????????????", maske); (* Vorgefertigte Maske *)
  265.   LOOP 
  266.    IF (wild[d] = CHR(0)) OR (d = HIGH(wild)) THEN
  267.     (* Wildcard zu Ende, Rest der Maske mit Blanks auffüllen *)
  268.     FOR i:= c TO cMaxLen DO maske[i]:= " "; END;
  269.     RETURN;
  270.    ELSIF (wild[d] = "*") THEN
  271.     (* Auf einen * muß ein Punkt in der Wildcard folgen! *E*.MOD ist illegal! *)
  272.     INC(d, 2); (* Punkt auslassen *)
  273.     EXIT; (* Fertig mit Prefix-Teil *)
  274.    ELSIF (wild[d] = ".") THEN
  275.     (* Punkt gefunden, Prefix bis zur Maximalen Länge mit Blanks auffüllen *)
  276.     FOR i:= c TO cPrefLen DO  maske[i]:= " ";  END; 
  277.     INC(d);
  278.     EXIT; (* Fertig mit Prefix-Teil *)
  279.    ELSE (* Zeichen aus wild nach maske übertragen *)
  280.     maske[c]:= wild[d];  INC(c);  INC(d);
  281.    END;
  282.   END;
  283.   c:= cPrefLen + 1; (* Index von maske auf "nach dem Punkt" einstellen *)
  284.   LOOP
  285.    IF (wild[d] = CHR(0)) OR (d = HIGH(wild)) THEN
  286.     (* Wildcard zu Ende, Rest der Maske mit Blanks auffüllen *)
  287.     FOR i:= c TO cMaxLen DO maske[i]:= " "; END;
  288.     RETURN;
  289.    END;
  290.    IF (c > cMaxLen) OR (wild[d]="*") THEN 
  291.     EXIT (* wild fertig, bzw. maske voll *)
  292.    END;
  293.    (* Zeichen aus wild nach maske übertragen *)
  294.    maske[c]:= wild[d]; INC(c); INC(d); 
  295.   END;
  296.  END MakeMask;
  297.  
  298.  
  299. VAR c, d: sCARDINAL;
  300.     wild, maske: ARRAY [0..11] OF CHAR;
  301.  
  302. BEGIN (* Ersetze *)
  303.  MakeMask (wildcard, wild); (* Masken erstellen *)
  304.  MakeMask (oldName, maske);
  305.  (* Alle legalen Zeichen aus wild nach maske übertragen (auch Blanks!) *)
  306.  FOR c:= 0 TO cMaxLen DO
  307.   IF wild[c] # "?" THEN maske[c]:= wild[c] END;
  308.  END;
  309.  (* new zur Sicherheit löschen *)
  310.  FOR c:= 0 TO cMaxLen DO new[c]:= CHR(0);  END;
  311.  c:= 0;  d:= 0;
  312.  LOOP
  313.   IF (d > cMaxLen) THEN EXIT END; (* Neuer Name fertig *)
  314.   IF d = cPrefLen THEN (* Punktposition, Punkt in new einsetzen *)
  315.    new[c]:= ".";  INC(c);  INC(d); 
  316.   END;
  317.   IF (maske[d] # "?") AND (maske[d] # " ") THEN  
  318.    (* Blanks und ? aussparen, haben nix im neuen Namen zu suchen! *)
  319.    new[c]:= maske[d];  INC(c); INC(d);
  320.   ELSE
  321.    INC(d);
  322.   END;
  323.  END;
  324. END Replace;
  325.  
  326.  
  327.  
  328. CONST   GEMtrap = 88H;
  329.         Kennung = 'FSmp';
  330.  
  331. VAR     c:      sCARDINAL;
  332.         adr:    ADDRESS;
  333.  
  334. BEGIN
  335.  slash[0]:= '\';
  336.  defDtaPtr:= ADR(defDTA);
  337.  exselector:= XBRA.Installed (Kennung, GEMtrap, adr);
  338.  MagicDOS.Super (stack);  c:= sys^.osVersion;  MagicDOS.Super (stack);
  339.  CASE c OF
  340.   0100H:  version:= Tos10;|
  341.   0102H:  version:= Tos12;|
  342.   0104H:  version:= Tos14; exselector:= TRUE;|
  343.   0106H:  version:= Tos16; exselector:= TRUE;|
  344.   0300H:  version:= Tos30; exselector:= TRUE;|
  345.   ELSE    version:= unknown;
  346.  END;
  347.  stack:= 0;
  348. END mtDir.
  349.  
  350.